home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / modprolg / mod-prol.lha / Prolog / cmplib / src / $tprog1.P < prev    next >
Text File  |  1992-01-24  |  16KB  |  461 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona, 1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24. /* $tprog1.P */
  25.  
  26. /* This program is the beginning of an attempt to write a translator that
  27. will take a preprocessed prolog program and produce a list of PIL
  28. instructions that implements the program.  The preprocessor adds pragma
  29. information to the program to make it possible for it to be processed.  We
  30. use the following representation: 
  31.  
  32.   preddef(Name,Arity,Clauses,Pragma,Exrefs)
  33.     where
  34.     Name is the predicate name.
  35.     Arity is the arity of the predicate.
  36.     Clauses is a list of clause terms that represent the defining rules.
  37.     Pragma is a list, empty for the moment.
  38.     Exrefs is a list (with tail a var) of external references: 
  39.       er(Predname,Ep) where Ep is the entry point addr of predicate
  40.       Predname.
  41.  
  42.   clause(Args,Clause,Pragma)
  43.     where
  44.     Args is a list of the formal parameters in the head of the clause.
  45.       (Arity long).
  46.     Clause is a term representing the literals on the rhs of the rule.
  47.     Pragma is a list; s(_,_) is a symbol table with information
  48.       concerning the variables that appear in the clause. 
  49.       all(y) indicates alloc-dealloc is necessary, all(n) indicates 
  50.       it's not nec.
  51.  
  52. A clause is represented as a term with structure symbols
  53. and(Firstconjunct,Pragma,Secondconjunct),
  54. or(Firstdisjunct,Pragma,Seconddisjunct), not(Negformula,Pragma), or nil if
  55. it is empty.  Goals on the right hand side are represented as:
  56.  
  57. '_call'(Predname,Arglist,Pragma):
  58.     where
  59.     Predname is the predicate name.
  60.     Arglist is the list of arguments.
  61.     Pragma is the pragma; nv(N) means that N is the size of the 
  62.       activation record at this point.
  63.  
  64. For example p(a,b) is represented as '_call'(p,[[a],[b]],[nv(1)]).
  65. Structure and constants are represented as lists, not as normal structures.
  66. Thus f(a,b) would be represented as [f,[a],[b]].  Constants are represented
  67. as 0-ary structures, i.e., lists of length one.  Variables are represented
  68. using v(Vid,Pragma), where Vid is a constant symbol representing the name,
  69. and Pragma is a list.  In the pragma, d(L) indicates that L is the location
  70. in the AR of this variable (or its register if it is a temporary) ; occ(f)
  71. indicates that this is the first occurrence and occ(s) a subsequent
  72. occurrence; k(t) indicates it is a temporary variable, k(p) indicates a
  73. permanent variable, k(u) indicates an unsafe occurrence of a permanent
  74. variable.  k(vh) indicates a void (anonymous) variable occurring at the top
  75. level in the head of a clause, k(vb) indicates a void variable occurring at
  76. the top level in the body of a clause.  */
  77.  
  78. /* For the clauses:
  79.     p(X,a) :- r(Y,X),s(Y,f(g(g(X)),f(Y,b))).
  80.     p(B,c).
  81.     p(f(a,g(X)),f(g(a),X)).
  82.  
  83. The query is:
  84.  
  85. tpred(preddef(p,
  86.        2,
  87.        [clause([v(x,[k(p),d(2),occ(f)]),[a]],
  88.            and('_call'(r,
  89.                 [v(y,[k(p),d(3),occ(f)]),
  90.                  v(x,[k(p),d(2),occ(s)])],
  91.                 [nv(2)]),
  92.                [],
  93.                '_call'(s,
  94.                 [v(y,[k(u),d(3),occ(s)]),
  95.                  [f,[g,[g,v(x,[k(p),d(2),occ(s)])]],
  96.                 [f,v(y,[k(p),d(3),occ(s)]),[b]]]],
  97.                 [nv(2)])
  98.               ),
  99.            [all(y)]),
  100.         clause([v(b,[k(t),d(1),occ(f)]),[c]],nil,[nv(0),all(n)]),
  101.         clause([[f,[a],[g,v(x,[k(t),d(3),occ(f)])]],
  102.             [f,[g,[a]],v(x,[k(t),d(3),occ(s)])]],
  103.            nil,
  104.            [all(n)])
  105.        ],
  106.        []),
  107.       Label,
  108.       Pil,[],Exref).
  109.  
  110. */
  111.  
  112. /* ----------------------------------------------------------------------
  113.  
  114.    change to pragma representation for variables : for greater efficiency,
  115.    the Pragma information for variables is being represented as a term,
  116.    "vrec(Type,Occ,Loc,Misc)" where Type is the type of the variable (k(T)
  117.    in old representation), Occ indicates whether this is a first or
  118.    subsequent occurrence (occ(Occ) of older representation), Loc gives the
  119.    location of the variable (d(Loc) in old representation), and Misc stores
  120.    other information as a list.
  121.  
  122.    - saumya debray, july 8 1985
  123.    ---------------------------------------------------------------------- */
  124.  
  125. /* **********************************************************************
  126. $tprog1_export([$tprog/3]).
  127.  
  128. $tprog1_use : $index1, $blist, $meta, $computil1, $inline1, $geninline1,
  129.           $tgoal1, $glob, $aux1, $tcond1, $listutil1, $disjunc1
  130. ********************************************************************** */
  131.  
  132.  
  133. /* $tprog(Progdef,Pil,Pilr) is true if the translation of the Progdef (a
  134. list of Predicates) is the difference list Pil-Pilr.            */
  135.  
  136. $tprog([],Pil,Pil,_).
  137. $tprog([Preddef|Prog],Pil,Pilr,Prag) :-
  138.     $tpred(Preddef,Pil,Pilr1,Prag),
  139.     $tprog(Prog,Pilr1,Pilr,Prag).
  140.  
  141. /* $tpred(Preddef,Label,Pil,Pilr) is true if the translation of Preddef
  142. is the difference list Pil-Pilr, with entry point Label. $tpred loops
  143. through the clauses.  */
  144.  
  145. $tpred(preddef(Pname,Arity,[Oneclause],P),Pil,Pilr,_) :- !,
  146.     ($comp_builtin(Pname,Arity,_) ->
  147.     $umsg(['*** Warning: redefining builtin ',Pname,'/',Arity]) ;
  148.     true
  149.     ),
  150.     $tclause(Oneclause,P,Pil,Pilr,0).
  151. $tpred(preddef(Pname,Arity,CList,P),Pil,Pilr,Prag) :- 
  152.     ($comp_builtin(Pname,Arity,_) ->
  153.         $umsg(['*** Warning: redefining builtin ',Pname,'/',Arity]) ;
  154.         true
  155.     ),
  156.     $index(Pname,Arity,CList,P,Pil,Pil0,Prag,SwList),
  157.     $length(CList,N),
  158.     ((N =< 3, not($member2(trace,Prag)), $tail_rec(CList,Pname,Arity)) ->
  159.         $get_indexinst(Pil,IndList) ;
  160.         IndList = []
  161.     ),
  162.     $tclauses(CList,P,Pil1,Pilr,SwList),
  163.     ((IndList = [Inst|_],
  164.       (Inst ?= switchonterm(_,_,_) ; Inst ?= switchonlist(_,_,_))
  165.      ) ->
  166.         $subst_exec(Pil1,Pname,Arity,IndList,Pil0,Pilr) ;
  167.         Pil1 = Pil0
  168.     ).
  169.  
  170. /* $tclauses generates retry and trust instructions for each clause */
  171.  
  172. $tclauses([],_,Pil,Pil,_).
  173. $tclauses([Clause|Restclauses],PredPrag,Pil,Pilr,SwList) :- 
  174.     $tclause(Clause,PredPrag,Pil,Pil1,SwList),
  175.     $tclauses(Restclauses,PredPrag,Pil1,Pilr,SwList).
  176.  
  177.  
  178. /* $tclause(Clause,Pil,Piltail) is true if Pil-Piltail is the code that
  179. translates clause Clause. */
  180.  
  181. $tclause(clause(Args,Body,Prag),PredPrag,[label(L)|Pil],Pilr,SwL) :- 
  182.     $member1(all(A),Prag),
  183.     $member1(label(L),Prag),
  184.     $length(Args,N),
  185.     $reserve(N, [], Tin), !,
  186.     $tprog_getnvars(Body,Nv), 
  187.     (SwL =:= 1 ->
  188.         $theadpars_swlist(Args,A,L,PredPrag,Nv,Pil,Pilr1,Tin,TRegs1) ;
  189.     ((A ?= y ->
  190.          Pil = [allocate(Nv)|Pil1] ;
  191.          Pil = Pil1
  192.      ),
  193.          $theadpars(Args,1,PredPrag,Pil1,Pilr1,Tin,TRegs1)
  194.     )
  195.     ),
  196.     $tbody(Body,A,Pilr1,Pilr,TRegs1,_,[]).
  197.  
  198. /* $theadpars_swlist loops through the formal parm list.  It's similar
  199.    to $theadpars, expect that it generates special code for the first
  200.    parameter, to handle the switchonlist instruction properly.       */
  201.  
  202. $theadpars_swlist([Arg1|ARest],A,L,PPrag,Nv,Pil,Pilr,Tin,Tout) :-
  203.      $tpar_swlist(Arg1,A,L,Nv,Pil,Pilm,Tin,Tmid),
  204.      $theadpars(ARest,2,PPrag,Pilm,Pilr,Tmid,Tout).
  205.  
  206. $tpar_swlist([[]],A,(P,N,L),Nv,Pil,Pilr,Tin,Tout) :-
  207.      $concat_atom(L,nil,L1),
  208.      $release(1,Tin,Tout),
  209.      (A = y ->
  210.          Pil = [label((P,N,L1)),allocate(Nv),getnil(1)|Pilr] ;
  211.         /* not worth optimizing away getnil if must allocate */
  212.     (L3 = (P,N,L4), $gennum(L4),
  213.           Pil = [getnil(1),label((P,N,L1))|Pilr]
  214.     )
  215.      ).
  216. $tpar_swlist(['.'|Args],A,(P,N,L),Nv,Pil,Pilr,Tin,Tout) :-
  217.      $concat_atom(L,lis,L1),
  218.      $release(1,Tin,Tmid),
  219.      L3 = (P,N,L4), $gennum(L4),
  220.      (A = y ->
  221.          (Pil = [allocate(Nv), getlist(1)|Pilm1],
  222.      Pilm2 = [allocate(Nv),getlist_k(1)|Pilm3]
  223.     ) ;
  224.     (Pil = [getlist(1)|Pilm1],
  225.      Pilm2 = [getlist_k(1)|Pilm3]
  226.     )
  227.      ),
  228.      (Args = [v(_,vrec(t,_,_,_)),v(_,vrec(t,_,_,_))] ->
  229.          ($tsubpars(h,Args,Pilm1,[jump(L3),label((P,N,L1))|Pilm2],Tmid,Tout),
  230.      $tsubpars(h,Args,Pilm3,[label(L3)|Pilr],Tmid,_)
  231.     ) ;
  232.     (Pilm1 = [jump(L3),label((P,N,L1))|Pilm2],
  233.      Pilm3 = [label(L3)|Pilm3a],
  234.      $tsubpars(h,Args,Pilm3a,Pilr,Tmid,Tout)
  235.     )
  236.      ).     
  237.  
  238. /* $theadpars loops through the formal parameter list */
  239.  
  240. $theadpars([],_,_,Pil,Pil,T,T).
  241.  
  242. /* TRin = list of temp registers in use at entry; TRout = list of temps
  243.    in use at exit.                            */
  244.  
  245. $theadpars([Par|Rest],N,PredPrag,Pil,Pilr,TRin,TRout) :-
  246.     $tpar(h,Par,N,Pil,Pil1,TRin,TRmid,PredPrag),
  247.     N1 is N+1,
  248.     $theadpars(Rest,N1,PredPrag,Pil1,Pilr,TRmid,TRout).
  249.  
  250. :- mode($tbody,7,[nv,d,d,d,d,d,d]).
  251.  
  252. $tbody(nil,_,[proceed|Pil],Pil,T,T,_) :- !.
  253. $tbody('_call'(Pred,Args,CPrag),A,Pil,Pilr,Tin,Tout,HoldRegs) :-    
  254.     $tbodycall(Args,A,Pil,Pilr,Tin,Tout,HoldRegs,Pred,CPrag).
  255. $tbody(and(Goal,_,Goals),A,Pil,Pilr,Tin,Tout,HoldRegs) :- 
  256.     $tbody(Goal,A,Pil,Pil1,Tin,Tmid,HoldRegs),
  257.     $tbody(Goals,A,Pil1,Pilr,Tmid,Tout,HoldRegs).
  258. $tbody(if_then_else(Test,P,TGoal,FGoal),A,Pil,Pilr,Tin,Tout,Hold0) :-
  259.     $gen_label(TLabel), $gen_label(FLabel), $gen_label(After),
  260.     $member1(tvars(TV),P),
  261.     $append(TV,Hold0,Hold1),
  262.     $tcond(Test,TLabel,FLabel,Pil,[label(TLabel)|Pilm1],Tin,Tmid,Hold1),
  263.     $tbody(TGoal,A,Pilm1,[jump(After),label(FLabel)|Pilm2],Tmid,Tout0,Hold1),
  264.     $merge(Tmid,Tout0,Tout1),
  265.     $tbody(FGoal,A,Pilm2,[label(After)|Pilr],Tout1,Tout2,Hold0), /* tvar may be in */
  266.     $merge(Tout1,Tout2,Tout), !.        /* branches of an i-t-e */
  267. $tbody(or(Goal,_,Goals),A,Pil,Pilr,Tin,[],Hold) :-
  268.     $tprog_getnvars(Goal,Nv),
  269.     $gen_label(DLabel), arg(1,DLabel,D),
  270.     $gen_label(NDisj), $gen_label(After),
  271.     XPil = [call(D,-1,Nv),label(DLabel),trymeelse(NDisj,0)|Pilm1],
  272.     $tbody(Goal,A,Pilm1,Pilm2,Tin,_,Hold),
  273.     Pilm2 = [jump(After),label(NDisj),trustmeelsefail(0)|Pilm3],
  274.     $tbody(Goals,A,Pilm3,[label(After)|Pilr],Tin,_,Hold),
  275.     $optimize_CP(XPil,Pil), !.
  276.  
  277. $tbodycall(Args,A,Pil,Pilr,Tin,Tout,Hold,Pred,CPrag) :-
  278.     $member1(lastlit,CPrag),
  279.     !,
  280.     $length(Args, Arity),
  281.     (($inline(Pred,Arity), 
  282.       ((A = y, Pil1 = [deallocate,proceed|Pilr]) ;
  283.        (A = n, Pil1 = [proceed | Pilr])
  284.       ),
  285.       $geninline(Pred,Args,Hold,Pil,Pil1,Tin,Tout)
  286.      ) ;
  287.      (((A = y, Pil1 = [deallocate,execute((Pred,Arity))|Pilr]) ;
  288.        (A = n, Pil1 = [execute((Pred,Arity)) | Pilr])
  289.       ),
  290.       $reserve(Arity,Tin,T1), Tout = [],
  291.       $tgoalargs(Args,1,Pil,Pil1,CPrag,T1,_)
  292.      )
  293.     ).
  294. $tbodycall(Args,_,Pil,Pilr,Tin,Tout,Hold,Pred,CPrag) :-
  295.     $length(Args, Arity),
  296.     (($inline(Pred,Arity),
  297.       $geninline(Pred,Args,Hold,Pil,Pilr,Tin,Tout)
  298.      ) ;
  299.      (($member1(nv(Nv), CPrag),
  300.        $reserve(Arity,Tin,T1), Tout = [],
  301.        $tgoalargs(Args,1,Pil,[call(Pred,Arity,Nv)|Pilr],CPrag,T1,_)
  302.       )
  303.      )
  304.     ).
  305.  
  306. $optimize_CP(XPil,XPil) :- var(XPil), !.
  307. $optimize_CP([Inst|Tail], [Inst|Tail]) :- var(Tail), !.
  308. $optimize_CP([trymeelse(L1,N),
  309.          call(D0,-1,_),
  310.          label((D0,-1,_)),
  311.          trymeelse(L2,N)|Xr],
  312.         [trymeelse(L2,N)|Pr]) :-
  313.     $optimize_CP_1(L1,L2,Xr,Pr1),
  314.     $optimize_CP_2(Pr1,Pr).
  315. $optimize_CP([trustmeelsefail(N),
  316.          call(D0,-1,_),
  317.          label((D0,-1,_)),         
  318.          trymeelse(L2,N)|Xr],
  319.         [retrymeelse(L2,N)|Xr]).
  320. $optimize_CP([Inst|XPRest],[Inst|PRest]) :-
  321.     $optimize_CP(XPRest,PRest).
  322.  
  323.  
  324. $optimize_CP_1(L1,L2,XPil,XPil) :- var(XPil).
  325. $optimize_CP_1(L1,L2,[label(L2),retrymeelse(L3,N)|XPRest],
  326.             [label(L2),retrymeelse(L3,N)|PRest]) :-
  327.         $optimize_CP_1(L1,L3,XPRest,PRest).
  328. $optimize_CP_1(L1,L2,[label(L2),trustmeelsefail(N)|XPRest],
  329.             [label(L2),retrymeelse(L1,N)|PRest]) :-
  330.         $optimize_CP_1(L1,L2,XPRest,PRest).
  331. $optimize_CP_1(L1,L2,[Inst|XPRest],[Inst|PRest]) :-
  332.         $optimize_CP_1(L1,L2,XPRest,PRest).
  333.  
  334.  
  335. $optimize_CP_2(Pil,Pil) :- var(Pil).
  336. $optimize_CP_2([trustmeelsefail(N),
  337.            call(D0,-1,_),
  338.            label((D0,-1,_)),
  339.            trymeelse(L1,N)|Rest],
  340.           [retrymeelse(L1,N)|Rest]).
  341. $optimize_CP_2([Inst|Rest],[Inst|Rest1]) :- $optimize_CP_2(Rest,Rest1).
  342.  
  343. :- mode($tprog_getnvars,2,[nv,d]).
  344.  
  345. $tprog_getnvars('_call'(_,_,CPrag), NVars) :-
  346.     (($member1(nv(NVars),CPrag),
  347.       (NVars = 0 ; true)) ;
  348.      NVars = 0
  349.     ).
  350. $tprog_getnvars(nil,0).
  351. $tprog_getnvars(and(Goal,_,_),NVars) :- $tprog_getnvars(Goal,NVars).
  352. $tprog_getnvars(or(Goal,_,_),NVars) :- $tprog_getnvars(Goal,NVars).
  353. $tprog_getnvars(not(Goal,_),NVars) :- $tprog_getnvars(Goal,NVars).
  354. $tprog_getnvars(if_then_else(_,_,Goal,_),NVars) :- $tprog_getnvars(Goal,NVars).
  355.  
  356. $get_indexinst(IList,IndexInst) :- 
  357.     var(IList) ->
  358.         IndexInst = [] ;
  359.         (IList = [Inst|IRest],
  360.          (Inst = label(_) ->
  361.             IndexInst = IndInstRest ; IndexInst = [Inst|IndInstRest]
  362.          ),
  363.          $get_indexinst(IRest,IndInstRest)
  364.         ).
  365.  
  366. $subst_exec(Pil,P,N,IList,Pil0,Pilr) :-
  367.     var(Pil) ->
  368.         Pil0 = Pilr ;
  369.         (Pil = [Inst|IRest],
  370.          (Inst = execute((P,N)) ->
  371.              (Pil0 = ['_$execmarker'|Pil0a],   /* '_$execmarker' tells the peephole */
  372.              $subst_exec1(IList,Pil0a,Pil1)   /*  optimizer that there was an "execute" */
  373.             ) ;                  /*  here.  The PO uses this info to  */
  374.             Pil0 = [Inst|Pil1]          /* when registers can be considered dead */
  375.          ),
  376.          $subst_exec(IRest,P,N,IList,Pil1,Pilr)
  377.         ).
  378.  
  379. $subst_exec1([],L,L).
  380. $subst_exec1([I|IRest],[I|LRest],L) :- $subst_exec1(IRest,LRest,L).
  381.  
  382. $tail_rec([clause(_,Body,_)|ClRest],P,N) :-
  383.     $tail_rec1(Body,P,N) ;
  384.     $tail_rec(ClRest,P,N).
  385.  
  386. $tail_rec1('_call'(P,Args,_),P,N) :- $length(Args,N).
  387. $tail_rec1(and(_,_,G),P,N) :- $tail_rec1(G,P,N).
  388. $tail_rec1(if_then_else(_,_,G1,G2),P,N) :- $tail_rec1(G1,P,N) ; $tail_rec1(G2,P,N).
  389. $tail_rec1(or(G1,_,G2),P,N) :- $tail_rec1(G1,P,N) ; $tail_rec1(G2,P,N).
  390.  
  391.  
  392. $tgoal('_call'(Pred,Args,Prag),Pil,Pilr,Tin,Tout) :-
  393.     $length(Args, Arity),
  394.     $inline(Pred,Arity),
  395.     !,
  396.     $geninline(Pred,Args,Prag,Pil,Pilr,Tin,Tout).
  397.  
  398. $tgoal('_call'(Pred,Args,Prag),Pil,Pilr,Tin,Tout) :-
  399.     $length(Args, Arity),
  400.     $member1(nv(Nvars),Prag),
  401.     $reserve(Arity,Tin,T1),
  402.     $tgoalargs(Args,1,Pil,[call(Pred,Arity,Nvars)|Pilr],Prag,T1,Tout).
  403.  
  404. /* loops through args */
  405. $tgoalargs([],_,Pil,Pil,_,T,T).
  406. $tgoalargs([Arg|Args],N,Pil,Pilr,Prag,Tin,Tout) :-
  407.     $tpar(b,Arg,N,Pil,Pil1,Tin,T1,[]),
  408.     N1 is N + 1,
  409.     $tgoalargs(Args,N1,Pil1,Pilr,Prag,T1,Tout).
  410.  
  411. /* generates gets,puts,blds,unis for a par*/
  412.  
  413. :- index($tpar,8,2).
  414.  
  415. $tpar(W,[Cid],N,Pil,Pilr,Tin,Tout,PredPrag) :- 
  416.     $coninst(W,Cid,N,Pil,Pilr),
  417.     (W = h -> $release(N,Tin,Tout) ; Tin = Tout).
  418.  
  419. $tpar(h,v(Vid,Prag),N,Pil,Pil,Tin,Tout,_) :-
  420.     $type(Prag,vh),        /* ignore void variables in head */
  421.     $release_if_done(Vid,N,Prag,[],Tin,Tout).
  422.  
  423. $tpar(W,v(Vid,Prag),N,Pil,Pilr,Tin,Tout,PredPrag) :-
  424.      Prag = vrec(T,L,Loc,_),
  425.      ((W = h, $release_if_done(Vid,N,Prag,[],Tin,Tmid)) ; Tin = Tmid),
  426.      ((T = t, $alloc_reg1(Prag,N,Tmid,Tout)) ; Tmid = Tout),
  427.      $varinst(W,L,T,Loc,N,Pil,Pilr,Tout).
  428.  
  429. $tpar(W,[Sid|Args],N,[Inst|Pil],Pilr,Tin,Tout,Prag) :-
  430.     Args=[_|_],
  431.     $length(Args,Arity),
  432.     $strinst(W,(Sid,Arity),N,Inst),
  433.     (W = h -> $release(N,Tin,Tmid) ; Tmid = Tin),
  434.     $tsubpars(W,Args,Pil,Pilr,Tmid,Tout).
  435.  
  436. /* loops through sub fields of a par */
  437. :- index($tsubpars,6,2).
  438.  
  439. $tsubpars(_,[],Pil,Pil,T,T).
  440. $tsubpars(W,[Subpar|Subpars],Pil,Pilr,T1,T2) :-
  441.     $tsubpar(W,Subpar,Pil,Pil1,T1,T3),
  442.     $tsubpars(W,Subpars,Pil1,Pilr,T3,T2).
  443.  
  444. /* generates code for a subfield of par */
  445. :- index($tsubpar,6,2).
  446.  
  447. $tsubpar(W,v(Vid,Prag),Pil,Pilr,Tin,Tout) :-
  448.     $alloc_reg(Prag,Tin,Tmid),
  449.     $occ(Prag,L),  $loc(Prag,Loc), $type(Prag,T),
  450.     $varsubinst(W,L,T,Loc,Pil,Pilr,Tmid),
  451.     ((T = t, $release_if_done(Vid,Loc,Prag,[],Tmid,Tout)) ;
  452.      Tmid = Tout
  453.     ).
  454.  
  455. $tsubpar(W,[Cid],[Inst|Pilr],Pilr,T,T) :-
  456.     $consubinst(W,Cid,Inst).
  457.  
  458.  
  459.  
  460. /* end $tprog1.P *************************************************/
  461.